home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MySAT.p < prev    next >
Text File  |  1994-12-24  |  3KB  |  124 lines
  1. unit MySAT;
  2.  
  3. interface
  4.  
  5.     uses
  6.         SAT;
  7.  
  8.     function GetASingleFaceFromPICT (colorPICTid, bwPICTid: integer; bounds: Rect): FacePtr;
  9.     function StartGetttingFaces (colorPICTid, bwPICTid: integer; bounds: Rect): boolean;
  10.     function GetAFaceFromPICT (h, v: integer): FacePtr;
  11.     procedure FinishGettingFaces;
  12.  
  13. implementation
  14.  
  15.     uses
  16.         QDOffscreen;
  17.  
  18.     var
  19.         savePort: GrafPtr;
  20.         saveDev: GDHandle;
  21.         colour_ph, draw_ph: PicHandle;
  22.         offscreenGWorld: GWorldPtr;
  23.         pm: PixMapHandle;
  24.         transparent_colour: integer;
  25.         rowbytes: integer;
  26.         bounds0: rect;
  27.  
  28.     function StartGetttingFaces (colorPICTid, bwPICTid: integer; bounds: Rect): boolean;
  29.         var
  30.             err: OSErr;
  31.             baseaddr: Ptr;
  32.             r: rect;
  33.     begin
  34.         StartGetttingFaces := false;
  35.         SATGetPort(savePort, saveDev);
  36.         colour_ph := GetPicture(colorPICTid);
  37.         if gSAT.initDepth > 1 then begin
  38.             draw_ph := colour_ph;
  39.         end
  40.         else begin
  41.             draw_ph := GetPicture(bwPICTid);
  42.         end;
  43.         if (colour_ph <> nil) & (colour_ph^ <> nil) & (draw_ph <> nil) & (draw_ph^ <> nil) then begin
  44.             HNoPurge(Handle(colour_ph));
  45.             HNoPurge(Handle(draw_ph));
  46.             bounds0 := bounds;
  47.             OffsetRect(bounds0, -bounds0.left, -bounds0.top);
  48.             err := NewGWorld(offscreenGWorld, 8, bounds0, nil, nil, []);
  49.             if err = noErr then begin
  50.                 pm := GetGWorldPixMap(offscreenGWorld);
  51.                 if LockPixels(pm) then begin
  52.                     SetGWorld(CGrafPtr(offscreenGWorld), nil);
  53.                     r := colour_ph^^.picFrame;
  54.                     OffsetRect(r, -r.left, -r.top);
  55.                     DrawPicture(colour_ph, r);
  56.                     baseaddr := GetPixBaseAddr(pm);
  57.                     transparent_colour := baseaddr^;
  58.                     rowbytes := BAND(pm^^.rowBytes, $7FFF);
  59.                     StartGetttingFaces := true;
  60.                 end;
  61.             end;
  62.         end;
  63.     end;
  64.  
  65.     function GetAFaceFromPICT (h, v: integer): FacePtr;
  66.         var
  67.             err: OSErr;
  68.             baseaddr: Ptr;
  69.             r: rect;
  70.             theface: FacePtr;
  71.             x, y: integer;
  72.             p: Ptr;
  73.     begin
  74.         SetGWorld(CGrafPtr(offscreenGWorld), nil);
  75.         baseaddr := GetPixBaseAddr(pm);
  76.         r := colour_ph^^.picFrame;
  77.         OffsetRect(r, -r.left - h, -r.top - v);
  78.         DrawPicture(colour_ph, r);
  79.         baseaddr := GetPixBaseAddr(pm);
  80.         rowbytes := BAND(pm^^.rowBytes, $7FFF);
  81.         for y := 0 to bounds0.bottom - 1 do begin
  82.             for x := 0 to bounds0.right - 1 do begin
  83.                 p := Ptr(ord(baseaddr) + y * rowbytes + x);
  84.                 if p^ = transparent_colour then begin
  85.                     p^ := 0;
  86.                 end
  87.                 else begin
  88.                     p^ := 255;
  89.                 end;
  90.             end;
  91.         end;
  92.  
  93.         theface := SATNewFace(bounds0);
  94.  
  95.         SATSetPortFace(theface);
  96.         r := draw_ph^^.picFrame;
  97.         OffsetRect(r, -r.left - h, -r.top - v);
  98.         DrawPicture(draw_ph, r);
  99.  
  100.         SATSetPortMask(theface);
  101.         CopyBits(GrafPtr(offscreenGWorld)^.portBits, theport^.portBits, bounds0, bounds0, srcCopy, nil);
  102.         SATChangedFace(theface);
  103.  
  104.         GetAFaceFromPICT := theface;
  105.     end;
  106.  
  107.     procedure FinishGettingFaces;
  108.     begin
  109.         DisposeGWorld(offscreenGWorld);
  110.         HPurge(Handle(colour_ph));
  111.         HPurge(Handle(draw_ph));
  112.         SATSetPort(savePort, saveDev);
  113.     end;
  114.  
  115.     function GetASingleFaceFromPICT (colorPICTid, bwPICTid: integer; bounds: Rect): FacePtr;
  116.     begin
  117.         GetASingleFaceFromPICT := nil;
  118.         if StartGetttingFaces(colorPICTid, bwPICTid, bounds) then begin
  119.             GetASingleFaceFromPICT := GetAFaceFromPICT(bounds.left, bounds.top);
  120.             FinishGettingFaces;
  121.         end;
  122.     end;
  123.  
  124. end.